package FocusCrawler::FirstOrder::DomParser;
require Exporter;
our @ISA    = qw(Exporter);
our @EXPORT =
    qw(&get_filtered_content &get_url &get_tokens_from_elem &get_tokens_from_text);
our $VERSION = 1.00;

use YAML;
use URI;
use HTML::Parser;
use HTML::TreeBuilder;
use HTML::Tagset;
use Lingua::EN::StopWords qw(%StopWords);

my @ignorable_tags = grep { $_ ne 'a' } keys %HTML::Tagset::isPhraseMarkup;

my %stopwords = %StopWords;
$stopwords{$_} = 1 for 'a' .. 'z';
$stopwords{$_} = 1 for qw(http www htm html com index);
$stopwords{''} = 1;

my ($tokens_ref,             $anchor2page_callback,
    $facts_handler_callback, $anchor2target_callback
);
my $next_elem_index;
my %elem2index;
my %facts_seen;
my @url_tokens;

sub new {
    (   undef, $tokens_ref, $anchor2page_callback, $facts_handler_callback,
        $anchor2target_callback
    ) = @_;
    for ( keys %$tokens_ref ) {
        if (/^link:a url:(\w+)$/) {
            push @url_tokens, $1;
        }
    }
    bless {};
}

sub process {
    my ( $self, $content, $base, $digest, $start_elem_index ) = @_;

    $next_elem_index = $start_elem_index;
    %elem2index      = ();
    %facts_seen      = ();

    my $parser =
        HTML::TreeBuilder->new_from_content(
        &get_filtered_content($content) );
    $parser->attr_encoded(1);
    my @anchors = $parser->find_by_tag_name('a');

    foreach my $anchor (@anchors) {
        my $target_page = $anchor2page_callback->( $anchor, $base, $digest );
        next unless defined $target_page;

        my $path = 'link:a';

        my $anchor_index =
            &process_elem( $anchor, $path, $target_page, $base );

        my ( $elem, $elem_index, $last_elem, $last_elem_index ) =
            ( $anchor, $anchor_index );

        while ( $elem->tag ne 'body' ) {
            ( $last_elem, $last_elem_index ) = ( $elem, $elem_index );
            $elem = $elem->parent;
            $path .= ' parent:' . $elem->tag;
            $elem_index =
                &process_elem( $elem, $path, $last_elem_index, $base );
            last unless defined $elem_index;
            my @offsprings;
            foreach my $child ( grep { ref $_ and $_ ne $last_elem }
                $elem->content_list )
            {
                push @offsprings,
                    [ $child, $path . ' child:' . $child->tag, $elem_index ];
            }
            while (@offsprings) {
                my ( $offspring, $new_path, $parent_index ) =
                    @{ pop @offsprings };
                my $new_elem_index =
                    &process_elem( $offspring, $new_path, $parent_index,
                    $base );
                if ( defined $new_elem_index ) {
                    foreach my $offspring ( grep { ref $_ }
                        $offspring->content_list )
                    {
                        push @offsprings,
                            [
                            $offspring,
                            $new_path . ' child:' . $offspring->tag,
                            $new_elem_index
                            ];
                    }
                }
            }
        }
    }
    $parser->delete;
    return $next_elem_index;
}

sub process_elem {
    my ( $elem, $path, $last_elem_index, $base ) = @_;
    return undef unless exists $tokens_ref->{$path};

    my $elem_index = $elem2index{$elem};
    unless ( defined $elem_index ) {
        $elem_index = $next_elem_index++;
        $elem2index{$elem} = $elem_index;
        &fill_fact("text(e$elem_index, $_)")
            for grep { exists $tokens_ref->{"$path text:$_"} }
            @{ &get_tokens_from_elem($elem) };
        if ( $elem->tag eq 'a' ) {
            my $url = &get_url( $elem, $base );
            if ( defined $url and $path eq 'link:a' ) {
                for (@url_tokens) {
                    &fill_fact("url(e$elem_index, $_)") if $url =~ /$_/;
                }
            }
            if ( defined $anchor2target_callback
                and $anchor2target_callback->( $elem, $base ) )
            {
                &fill_fact("target(e$elem_index)")
                    if exists $tokens_ref->{"$path target"};
            }
        }
        if ( $elem->content_list == 1 and ref( ( $elem->content_list )[0] ) )
        {
            &fill_fact("only(e$elem_index)")
                if exists $tokens_ref->{"$path only"};
        }
    }

    if ( $path eq 'link:a' ) {
        &fill_fact("link(p$last_elem_index, e$elem_index)");
    }
    else {

        my ( $pred, $tag ) = $path =~ / (parent|child):(\w+)$/;

        if ( $pred ne 'parent' and $pred ne 'child' ) {
            print "Path: $path\n";
            print "Pred: $pred\n";
            die;
        }

        &fill_fact("$pred(e$last_elem_index, e$elem_index, $tag)");
    }
    return $elem_index;
}

sub get_filtered_content {
    my $html_parser =
        HTML::Parser->new( api_version => 3, marked_sections => 1 );
    $html_parser->ignore_elements(qw(script style));
    $html_parser->ignore_tags(@ignorable_tags);
    $html_parser->handler( default => [], '@{text}' );
    $html_parser->handler( process     => '' );
    $html_parser->handler( comment     => '' );
    $html_parser->handler( declaration => '' );
    $html_parser->parse(shift);
    $html_parser->eof;
    return join( ' ', @{ $html_parser->handler('default') } );
}

sub get_url {
    my ( $anchor, $base ) = @_;
    my $href = $anchor->attr('href');
    return undef unless defined $href;
    my $uri = URI->new_abs( $href, $base );
    return lc $uri->canonical->as_string;
}

sub get_tokens_from_elem {
    my $text = join ' ', grep { not ref $_ } shift->content_list;
    &get_tokens_from_text($text);
}

sub get_tokens_from_text {
    [ grep { not exists $stopwords{$_} } split /[^a-z]+/, lc shift ];
}

sub fill_fact {
    my $fact = shift;
    return if exists $facts_seen{$fact};
    $facts_seen{$fact} = 1;
    $facts_handler_callback->($fact);
}

1;
